home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tpmulti.zip
/
PRO_CON.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
15KB
|
410 lines
{$R-,S-,I-,D-,F-,V-,B-,N-,L- }
{$M 16384,0,655360 }
PROGRAM ProducerConsumer;
{ Solution of the Producer-Consumer-Problem; Example: Keyboard-I/O
What is does:
This program reads characters from the keyboard and displays them in
a small window on the screen. It also displays status-information about
the current state of the ring-buffer, the tasks and the semaphores in
the system.
ESC : Terminate
^S : The output of characters is suspended until ^Q is received.
Incoming characters are put into the ring-buffer, however, until
the buffer overflows.
^Q : Resume character output; the currently stored characters are
instantaneously displayed.
Stand: 6/88
Autor: Christian Philipps
Düsseldorfer Str. 316
4130 Moers 1
}
USES Crt, CpMulti;
CONST RBuffSize = 36; {Size of Ring-Buffer}
CritLin = 15;
CritCol = 51;
FullLin = 15;
FullCol = 34;
EmptyLin = 15;
EmptyCol = 42;
PEndLin = 15;
PEndCol = 12;
OutLin = 15;
OutCol = 24;
VAR RBuff : RECORD
Buff : ARRAY[0..RBuffSize] OF CHAR;
{Ring-Buffer; Last element
not used, thereby easier to
handle}
Critical : Pointer; {Semaphore for Access-Synchro-
nisation}
Full : Pointer; {Semaphore, used to count
used bffer-sots}
Empty : Pointer; {Semaphore, used to cont
empty buffer-slots}
Head : Byte; {Head- and Tailpointer}
Tail : Byte;
END;
OutputSem : Pointer; {Semaphore, used to control
character output}
ProgramEnd: Pointer; {Semphore, used to signal
program end}
ConsumerNo, {Task-IDs}
ProducerNo: TaskNoType;
{-----------------------------------------------------------------------------}
FUNCTION NextSlot(S:Byte):Byte;
{ Calculate the next buffer position }
BEGIN {NextSlot}
NextSlot := Succ(S) MOD RBuffSize;
END; {NextSlot}
{-----------------------------------------------------------------------------}
PROCEDURE WriteCharXY(X,Y:Byte; C:Char);
{ Output a character at X,Y. Thereby assure that the sequence GotoXY/Write is
always treated as an atomic action. This is done by blocking the CPU }
BEGIN {WriteCharXY}
BindCPU;
GotoXY(X,Y);
Write(C);
ReleaseCPU;
END; {WriteCharXY}
{-----------------------------------------------------------------------------}
PROCEDURE WriteByteXY(X,Y,B:Byte);
{ Output a two-digit byte-value at X,Y. See also: WriteCharXY for further
explanation }
BEGIN {WriteByteXY}
BindCPU;
GotoXY(X,Y);
Write(B:2);
ReleaseCPU;
END; {WriteByteXY}
{-----------------------------------------------------------------------------}
PROCEDURE Status;
{ Display Task-Status }
BEGIN {Status}
BindCPU;
GotoXY(65,9);
Write(StateText[GetTaskState(ConsumerNo)]:10);
GotoXY(65,22);
Write(StateText[GetTaskState(ProducerNo)]:10);
ReleaseCPU;
END; {Status}
{-----------------------------------------------------------------------------}
PROCEDURE SW(S:Pointer; c,l:byte);
{ Execute and visualize SemWait() }
BEGIN {SW}
WriteByteXY(C,L,SemGetSignals(S));
SemWait(S);
WriteByteXY(C,L,SemGetSignals(S));
Status;
END; {SW}
{-----------------------------------------------------------------------------}
PROCEDURE SS(S:Pointer; c,l:byte);
{ Execute and visualize SemSignal() }
BEGIN {SS}
SemSignal(S);
WriteByteXY(C,L,SemGetSignals(S));
Status;
END; {SS}
{-----------------------------------------------------------------------------}
FUNCTION RBuffPut(C:Char):BOOLEAN;
{ Insert a character into the ring-buffer. The function returns TRUE if
successful, otherwise FALSE. If FALSE is returned a buffer-overflow has
been detected.
The behavior of the output task is influenced by the input-control task
(^Q and ^S).
Therefore the input-control task must never become blocked for more than
a moment during the insertion of a character into the ring-buffer. If
we would simply wait for a slot to become empty, this would block the input
task which in turn prevented it from detecting a ^Q if output is currently
suspended. Thus the output task will be forever waiting for a ^S to be
signalled by the input-task whilst the input-task would be waiting for
the output-task to empty a slot in the ring-buffer.
Please note the position of the SemWait-Calls referring to the semaphore
"Critical"!! It is very important to keep the ring-buffer bound to our-
selves until the buffer-slot is actually filled! If we first had a look
at the signal-count of Empty to find out, whether an empty slot exists,
without having locked the buffer before, anoter task could theoretically
have taken away the last slot available between our SemGetSignals and our
SemWait. - Again the deadlock described above were the consequence. }
BEGIN {RBuffPut}
WITH RBuff DO
BEGIN
SW(Critical,CritCol,CritLin); {gain exclusive access}
IF SemGetSignals(Empty) = 0 {Buffer full}
THEN RBuffPut := False {prevent deadlock}
ELSE BEGIN
RBuffPut := True;
SW(Empty,EmptyCol,EmptyLin); {claim a slot}
Buff[Tail] := c; {insert character}
WriteCharXY(21+Tail,19,' ');
IF C = #13
THEN WriteCharXY(21+Tail,21,#188)
ELSE WriteCharXY(21+Tail,21,c);
Tail := NextSlot(Tail); {advance headpointer}
WriteCharXY(21+Tail,19,#25);
SS(Full,FullCol,FullLin); {count new character}
END;
SS(Critical,CritCol,CritLin); {release buffer}
END;
END; {RBuffPut}
{-----------------------------------------------------------------------------}
FUNCTION RBuffGet:Char;
{ Take the first Character out of the buffer and pass it to the application.
If the buffer is currently empty, wait. }
BEGIN {RBuffGet}
WITH RBuff DO
BEGIN
SW(Full,FullCol,FullLin); {ask for character}
SW(Critical,CritCol,CritLin); {gain exclusive access}
RBuffGet := Buff[Head]; {take character}
WriteCharXY(21+Head,23,' ');
Head := NextSlot(Head); {advance headpointer}
WriteCharXY(21+Head,23,#24);
SS(Critical,CritCol,CritLin); {release buffer}
SS(Empty,EmptyCol,EmptyLin); {count emptied slot}
END;
END; {RBuffGet}
{-----------------------------------------------------------------------------}
PROCEDURE Producer;
{ Input-Control Task: Read characters from the keyboard and store them
in the ring-buffer.
Whenever a ^S is received, the output of characters to the screen is
suspended until a ^Q is received }
VAR C : Char;
Display : Boolean;
Col : Byte;
BEGIN {Producer}
Display := True; {output active}
Col := 1;
REPEAT {endless loop}
WHILE Keypressed DO
BEGIN
C := ReadKey;
CASE C OF
^S: IF Display {if not already done}
THEN BEGIN
SW(OutputSem,OutCol,OutLin); {inhibit output}
Display := False; {store state}
END;
^Q: IF NOT Display {if output suspended}
THEN BEGIN
SS(OutputSem,OutCol,OutLin); {reenable output}
Display := True; {store state}
END;
ELSE {no special character}
BEGIN
IF NOT RBuffPut(C)
THEN BEGIN {Overflow}
BindCPU; {atomic action}
GotoXY(34,18);
TextBackground(White);
TextColor(Black);
Write(' Overflow ');
TextColor(White);
TextBackground(Black);
ReleaseCPU; {End atomic action}
END;
END;
END; {Case}
END;
Sched; {All characters used up;
give up time-slice}
UNTIL False;
END; {Producer}
{-----------------------------------------------------------------------------}
PROCEDURE Consumer;
{ This task takes characters out of the ring-buffer and displays them to the
screen.
Whenever a ^S is received by the input-control-task, the "OutputSem" is
marked busy which leads to a block of the Output-Task.
"OutputSem" is released when a ^Q is received.
If an ESC is encountered, this task sets the semaphore "ProgramEnd" to
signal program termination.
The Consumer-Task is executed with highest priority, because it spends
most of its time waiting for input. If, however, characters are avail-
able, these are processed as quickly as possible. }
CONST MaxCols = 50;
VAR C : Char;
Col : Byte;
BEGIN {Consumer}
Col := 1;
REPEAT {endless loop}
C := RBuffGet; {get character}
GotoXY(34,18); {clear overflow-message}
Write(' ');
IF C = #27
THEN SS(ProgramEnd,PendCol,PendLin) {end of program}
ELSE BEGIN
SW(OutPutSem,OutCol,OutLin); {wait for output permission}
IF (Col >= MaxCols) OR (C=#13) {display overflow / Return}
THEN BEGIN
BindCPU; {critical section}
GotoXY(7,8);
FOR Col := 1 TO MaxCols DO
Write(' ');
ReleaseCPU; {end of critical section}
Col := 1;
END;
IF C <> #13 {output character}
THEN BEGIN
WriteCharXY(6+Col,8,C);
Inc(Col);
END;
SS(OutPutSem,OutCol,OutLin); {increment signal-count}
END;
UNTIL False;
END; {Consumer}
{-----------------------------------------------------------------------------}
PROCEDURE DrawScreen;
BEGIN {DrawScreen}
ClrScr;
BindCPU;
GotoXY(15,1);
Write('P R O C E S S - S Y N C H R O N I S A T I O N');
GotoXY(18,3);
Write('A Solution Of The Producer-Consumer Problem');
GotoXY(24,4);
Write('Autor: Christian Philipps 6/88');
GotoXY(5,7);
Write('┌───────────────────────────────────────────────────┐');
GotoXY(5,8);
Write('│ │ Consumer-Task');
GotoXY(5,9);
Write('└───────────────────────────────────────────────────┘');
GotoXY(6,12);
Write('┌────────────┬───────────┬──────┬───────┬──────────┐');
GotoXY(6,13);
Write('│ ProgramEnd │ OutputSem │ Full │ Empty │ Critical │ Semaphores for');
GotoXY(6,14);
Write('├────────────┼───────────┼──────┼───────┼──────────┤ Prozess- and Access-');
GotoXY(6,15);
Write('│ │ │ │ │ │ synchronisation');
GotoXY(6,16);
Write('└────────────┴───────────┴──────┴───────┴──────────┘');
GotoXY(5,19);
Write('Head-Pointer');
GotoXY(20,20);
Write('┌────────────────────────────────────┐');
GotoXY(5,21);
Write('Ringpuffer -> │ │ Producer─Task');
GotoXY(20,22);
Write('└────────────────────────────────────┘');
GotoXY(5,23);
Write('Tail-Pointer');
TextColor(Black);
TextBackground(White);
GotoXY(1,25);
Write(' Ctrl-S Suspend Output / Ctrl-Q Resume Output / ESC End Program ');
TextColor(White);
TextBackground(Black);
ReleaseCPU;
WriteCharXY(25,11,#30);
WriteCharXY(35,11,#30);
WriteCharXY(42,11,#30);
WriteCharXY(51,11,#30);
WriteCharXY(25,17,#30);
WriteCharXY(35,17,#30);
WriteCharXY(42,17,#30);
WriteCharXY(51,17,#30);
WriteCharXY(21,19,#25);
WriteCharXY(21,23,#24);
END; {DrawScreen}
{-----------------------------------------------------------------------------}
FUNCTION InitConPro:BOOLEAN;
BEGIN {InitConPro}
InitConPro := False;
WITH RBuff DO
BEGIN
FillChar(Buff,RBuffSize,' '); {Clear buffer}
Head := 0;
Tail := 0;
IF CreateSem(Critical) <> Sem_OK {Create semaphores}
THEN Exit;
IF CreateSem(Full) <> Sem_OK
THEN Exit;
IF CreateSem(Empty) <> Sem_OK
THEN Exit;
SemSet(Empty,RBuffSize); {All slots are empty...}
SemClear(Full); {no one is full}
END;
IF CreateSem(ProgramEnd) <> Sem_Ok {Create program-end flag}
THEN Exit;
SemClear(ProgramEnd); {clear signal-count}
IF CreateSem(OutputSem) <> Sem_Ok {Create semaphore}
THEN Exit;
ConsumerNo := CreateTask(@Consumer,Pri_Kernel,500); {Create tasks}
ProducerNo := CreateTask(@Producer,Pri_User,500);
IF (ConsumerNo < 0) OR {Error?}
(ProducerNo < 0)
THEN Exit;
DrawScreen;
InitConPro := True;
END; {InitConPro}
{-----------------------------------------------------------------------------}
BEGIN {Main}
IF NOT InitConPro
THEN BEGIN
Writeln('Error during Initialisation!');
Halt;
END;
SW(ProgramEnd,PendCol,PendLin);
END. {Main}